00010	C  SUBRS.  SCMSS, TYPE
00020	
00100		SUBROUTINE SCMSS
00200		DATA ISEMI/';'/
00300		COMMON/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
00350	C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
00500		DIMENSION RLIST(200),NOMOR(6),WARN(6),R(8,100)
00600		COMMON/SCX/RHY(4),JALPHA(12),RB,RC,JZ,IRHY,JD,KA,KB,IZ
00610		1/STF/RSTFAC(8),RSTJC/FRMT/F78F(1),FA1(1),FA5(1),IREAD
00700		1/XRN/RN(4000) /ALF/INP(72),ML /SC/J,L,MK 
00900		1,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG,IXX,ISEMI,JG
01000		1 ,VX(50),IAMP,K,KN,M,MODE,IBLA
01100	      EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3))
01200		1,(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST),(R1,R,RN(3001))
01300		1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4))
01500		DATA IBLA/' '/,KSLA/'/'/,IXX/'X'/,LCNT/1/
01600		1,RHY/.5,.25,.125,.0625/,JALPHA/',','-','.','=','(',')','+',
01650		1 '*',':',';','"',' '/
01700		IF(R1.EQ.16.)GO TO 16
01800	C   FOR LETTERS
01900		IF(R1.NE.14.AND.R1.NE.144)GO TO 11
02000		MODE=1
02100		IBEAM=-1
02200		IZ=0
02300		IREAD=0
02400	11	IF(MODE)GO TO 111
02500		IF(R1.NE.144.)GO TO (1,2,3,4,5,8024)MODE
02600	2302	TYPE 80053
02700		IF(IREAD.EQ.0)TYPE 80051
02800		ACCEPT 80052,STAFF,L
02850		IF(STAFF.GE.99)GO TO 8027
02875	C  TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
02900		IF(IREAD.EQ.1)GO TO 80041
02950		IF(LOOK(L)+LOOKD(L).EQ.0)GO TO 2302
03000		IREAD=1
03100		REWIND 22
03200		CALL IFILE(22,L)
03300	2301	READ(22,21141,END=8027),L,INP
03400		IF(MODE.EQ.6)GO TO 1111
03500		IF(INP1.EQ.IBLA)GO TO 8006
03600		GO TO 80041
03700	1111	MODE=-1
03800		R(2,IZ+1)=-1.
03900		REND=1.0
04000		GO TO 8026
04200	C   ABOVE ALLOWS MORE STAVES TO BE READ
04300	
04400	111	IZ=0
04500		MODE=1
04600		GO TO 2302
04700	C  WILL READ ANOTHER STAFF
04800	80053	FORMAT(' TYPE STAFF NUM. '$)
04900	80051	FORMAT('+AND FILE NAME  '$)
05000	80052	FORMAT(F,A5)
05100	
05200	2	TYPE 8008,IRHY
05300	CC	GO TO 80042
05350		GO TO 1
05400	3	TYPE 8002
05500	330	ACCEPT 2114,N,L,INP3,INP4
05600		IF(N.EQ.'G')GO TO 8024
05700	C  TYPE 'GO' TO PASS LATER ITEMS
05800		IF(N.EQ.'9'.OR.N.EQ.'B')GO TO 99
05900		IF(N.EQ.'Y')GO TO 1
05950		IF(N.NE.'N'.AND.N.NE.' ')GO TO 11
05975	C  PICKS UP TYPOS
06000	2000	MODE=MODE+1
06100		GO TO 11
06200	4	TYPE 8023
06300		GO TO 330
06400	5	TYPE 8022
06500		GO TO 330
06600	8024	REND=-1.
06610		CALL HYDPOG(3)
06655	C  ERASES NOTE NUMBERS
06700		IF(IBEAM)GO TO 8006
06800	C  JUMP IF NO STEM NORMALIZATION NEEDED
06900	C	IF(MODE.LT.3)GO TO 8006
07000		IZ=IZ+1
07100		R(1,IZ)=19.
07200		R(2,IZ)=STAFF
07300	C   ADJUSTS NOTE STEMS, ETC.
07400	8006	MODE=MODE+1
07500		IF(IREAD.EQ.1)GO TO 2301
07600	8026	R(1,IZ+1)=100.
07700		IF(IREAD.EQ.2)REND=1.
07750	273	IF(IREAD.NE.1)INP(2)=0
07775	C  WHY =0 ABOVE?????
07800		RETURN
07900	
08300	
08400	8027	IREAD=2
08500		STAFF=99.
08600	C  STEMS ON ALL STAVES WILL NORMALIZE
08700		GO TO 8024
08800	C  READER IS NOW FINISHED
08900	
09000	99	IF(INP3.EQ.'9')GO TO 999
09200	C   ELSE GET ANOTHER CHANCE TO SAY 'NO'
09300	C  99=BACKUP,  999=ESCAPE
09400		MODE=MODE-1
09600		IF(MODE.GE.1)GO TO 11
10100	999	DO 2222 K=1,IZ
10200	2222	R(1,K)=99.
10400	9999	REND=100
10500		GO TO 8026
10600	
10800	8008	FORMAT(' TYPE ',I2,' RHYTHMS')
10900	8002	FORMAT(' ADD BEAMS?  '$)
11000	8022	FORMAT(' ADD SLURS?  '$)
11100	8023	FORMAT(' ADD MARKS?  '$)
11200	8011	FORMAT(1XI3,' MORE RHYTHMS NEEDED'/)
11210	8015	K=IRHY-I+1
11400		TYPE 8011,K
11500		IF(IREAD.EQ.0)GO TO 11
11600		IZ=0
11700		IREAD=0
11800		MODE=5
11900		GO TO 8024
12000	
12100	6	MODE=5
12200		IF(IREAD.NE.0)GO TO 8006
12300	CC1	TYPE 8005
12400	1	CALL TYPE
12500	CC80042	ACCEPT 2114,INP
12600		IF(INP1.EQ.IBLA) GO TO 1
12700		IF(INP1.EQ.'9'.AND.INP2.EQ.'9')GO TO 99
12800	C  TYPE '99' TO BACK-UP
12900	80041	IF(MODE.GE.3)GO TO 133
13100		RETRO=-1.
13200		I=1
13300		PARENS=0
13400		MOT=0
13500	      JZ=1  
13600		IAMP=0
13700	C  IAMP IS 'BLANK LINE'FLAG ON PP1-3.
13800	      KL=0  
13900	      RA=0  
14000	2408	MLX=1
14100		L=-1
14200		DO 2999 K=1,72
14300		N=INP(K)
14400		IF(N.EQ.IBLA)GO TO 2999
14500		L=0 
14600		IF(N.NE.'*'.AND.N.NE.ISEMI)GO TO 2999
14700	C  READS 72 CHARS. INCLUDING *.
14800		INP(K+1)=ISEMI
14900		GO TO 1773
15000	C  --- X/Y/Z* ---  WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
15100	2999	CONTINUE
15200		IF(IREAD.EQ.1)GO TO 8015
15300		GO TO 273
15400	C   ERROR IF NO '*' OR ';' AT END OF LINE.
15500	
15600	1299	IF(JZ.NE.0)GO TO 1773
15700	7773	IF(IREAD.EQ.0)GO TO 77731
15800	C   BYPASS IF NOT USING EDIT FILE
15900		READ(22,21141),L,INP
16000	C   TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
16100		GO TO 77732
16200	CC77731	TYPE 8005
16300	CC  	ACCEPT 2114,INP
16350	77731	CALL TYPE
16400		IF(INP1.EQ.IBLA)GO TO 7773
16500	77732	JM=-1
16600		JZ=0
16700		GO TO 2408
16800	C   'LISTS' MUST END WITH * 
16900	1773	JZ=0
17000		DBST=1.
17100	17731	ML=MLX
17200		IF(PARENS.LE.0.)GO TO 975
17300	C  PARENS=-1, OPENS; =1, CLOSES; =0, NONE
17400	3362	PARENS=0
17500		MOT=I-LMOT
17600		IF(LCNT+MOT.LT.198)GO TO 33621
17700		DATA NOMOR/30H(' NO ROOM FOR MOTIVE ',A1/)   / 
17800		TYPE NOMOR,JMOT
17900		GO TO 1
18000	33621	JLIST(LCNT+1)=MOT
18100		LCNT=LCNT+2
18200		DO 2140 JG=0,MOT-1
18300	2140	RLIST(LCNT+JG)=V(LMOT+JG)
18400		LCNT=LCNT+MOT
18500		IF(IAMP)GO TO 3013
18700	C  FOR CLOSE PARENS ON LAST ITEM
18800	C   STORE MOTIVE IN RLIST ARRAY
18900	
19000	975	DO 236 JDD=ML,72
19100		JD=JDD
19200		N=INP(JD)
19300	C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC.  CAN USE 26 LABELS.
19400		IF(N.NE.'('.AND.N.NE.')'.AND.N.NE.':')GO TO 2361
19500		INP(JD)=IBLA
19600		IF(N.NE.':')GO TO 1113
19700		DBST=-1.
19800		GO TO 236
19900	C  FOR 'DOUBLE STOPS'
20000	1113	L=JD-1
20100	5113	IF(INP(L).NE.IBLA)GO TO 2113
20200		L=L-1
20300		GO TO 5113
20400	2113	IF(N.EQ.')')GO TO 3361
20500	C  ONLY ONE () AS YET,  NO NESTING
20600	1140	JMOT=INP(L)
20700	C   MOTIVE NAME
20800		DO 11401 JC=1,LCNT-1
20900		IF(JMOT.NE.JLIST(JC))GO TO 11401
21000	C  FINDS DUPLICATE IDENTIFIER
21200	11402	FORMAT(' MOTIVIC (',A1,') USED TWICE')
21300	CC	GO TO 1
21400	C  FOR BACKUP
21500	11401	CONTINUE
21600		JLIST(LCNT)=JMOT
21700		PARENS=-1.
21800	C   A PARENTH IS OPEN
21900		INP(L)=IBLA
22000		LMOT=I
22100	C   LMOT IS CURRENT POINT IN V ARRAY
22200		GO TO 236
22300	3361	IF(PARENS.NE.0)GO TO 33612
22400		DATA WARN/30H(' PARENTH ERROR - GOING ON'/)/
22500		TYPE WARN
22600	33611	INP(JD)=IBLA
22700		GO TO 236
22800	33612	PARENS=1.
22900	C   SETS PARENS CLOSED FLAG
23000		GO TO 33611
23100	C   NO INVERSIONS POSSIBLE NOW
23200	2361	IF(N.NE.'@')GO TO 5361
23300		DO 113 L=1,72
23400		K=JD+L
23500	C   K IS USED AT 240!!!
23600		JG=INP(K)
23700		IF(JG.NE.'-')GO TO 7113
23800		RETRO=0
23900		INP(K)=IBLA
24000		GO TO 113
24100	7113	IF(JG.NE.IBLA)GO TO 4113
24200	113	CONTINUE
24300	4113	DO 6361 L=1,LCNT
24400		IF(JG.NE.JLIST(L))GO TO 6361
24500		VX1=0
24600		DO 40 M=JD+2,72
24700		JG=INP(M)
24800		IF(JG.EQ.IBLA)GO TO 40
24900		IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
25000		ML=M
25100		GO TO 240
25200	40	CONTINUE
25300	240	JC=JM
25400		JM=-1
25500		INP(K)=IBLA
25600		JA=0
25700	C   MUST BE ZERO IN SCANR
25800		CALL SCANR
25900		JM=JC
26000	140	JC=1
26100		KN=L+2
26210		M=KN+JLIST(L+1)
26300		IF(RETRO)GO TO 940
26400		KN=M-1
26550		M=L+1
26600		JC=-1
26700		RETRO=-1.
26800	
26900	940	Z=RLIST(KN)
27000		IF(VX1.EQ.0)GO TO 540
27100	C  " @Q N "  WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
27200		IF(MODE.EQ.1)GO TO 440
27300	C  MODE 1 IS NOTES, 2 IS RHY.
27400		V(I)=Z*VX1
27500		GO TO 7361
27600	440	IF(Z.EQ.85.)GO TO 540
27700		V(I)=Z+VX1
27800		GO TO 7361
27900	540	V(I)=Z
28000	7361	I=I+1
28100		KN=KN+JC
28200		IF(KN.NE.M)GO TO 940
28300	
28400		RB=V(I-1)
28600		DO 8361 L=JD,72
28700		JG=INP(L)
28800		INP(L)=IBLA
28900		IF(JG.EQ.KSLA)GO TO 9361
29000		IF(JG.EQ.ISEMI)GO TO 93611
29200	8361	IF(JG.EQ.'*')IAMP=-1
29300	9361	MLX=L
29400		IF(IAMP.EQ.0)GO TO 17731
29600		JZ=-1
29700	93611	IF(IAMP)GO TO 3013
29900		GO TO 7773
30000	6361	CONTINUE
30100		TYPE 6362,JG
30200		GO TO 11402
30300	6362	FORMAT(' MOTIVIC (',A1,') NOT FOUND')
30400	C @@@@@@@@@@@@@@@@@@@@@@@@@@
30500	5361	IF(N.NE.KSLA)GO TO 636
30600		MLX=JD+1
30700		JZ=-1
30800		INP(JD)=ISEMI
30900	436	IF(INP(MLX).NE.IBLA)GO TO 103
31000		MLX=MLX+1
31100		GO TO 436
31200	636	IF(N.EQ.ISEMI)GO TO 103
31300	936	IF(N.NE.'.')GO TO 736
31400		L=INP(JD+1)
31500		KL=NALF(L)
31600		IF(L.GT.0.AND.KL.GE.0.AND.KL.LE.9)GO TO 236
31700	C   JUMP IF IT'S A NUMBER
31800		IF(MODE.EQ.2)INP(JD)=1
31900	C :::::::::******* ↑↑↑↑ MODE #?
32000		GO TO 236
32100	C   CHANGES DOTTED RHYTHMS TO '1'S.
32200	736	IF(N.NE.'*')GO TO 236
32300		IAMP=-1
32400		INP(JD)=ISEMI
32600		GO TO 103
32700	236	CONTINUE
     

00100	C   FOR ENTERING TEXT: 16, POS., STF., NT#., SIZE,  RHYTHM≠0
00200	2114	FORMAT(72A1)
00300	21141	FORMAT(I,72A1)
00400	16	RC=R(4,1)
00500		IBEAM=-1
00600		RB=R(3,1)
00700		RNFLG=R(5,1)
00800	C  RNFLG ≠0 CALLS NOTE NUM. SETUP
00900	161	IF(RC.EQ.0)RC=1.0
01000	CC	TYPE 8005
01100	CC	ACCEPT 2114,INP
01150		CALL TYPE
01200		DO 31 KN=72,1,-1
01300	31	IF(INP(KN).NE.IBLA)GO TO 33
01400	C  KN=NUM OF CHARACTERS
01500	C  DON'T END WITH '*' IN 'LETTERS' INPUT!!!!!!!!
01550	C  , - . = ( ) + * : ; BLANK --THIS IS ORDER PAST ALPHAB.
01600	33	L=1
01700		RA=R(2,1)
01800	C   RA= POSITION OF EACH LETTER
01900	C   RB= NOTE #
02000	C   RC= SIZE FACTOR
02050	CC	IF(RNFLG.NE.0)CALL SETUP
02100		IZ=0
02200	368	IZ=IZ+1
02300		R(1,IZ)=16.
02400		R(2,IZ)=RA 
02500	C  NEXT IS A MAGIC NUMBER FOR SPACING LETTERS.
02600		Y=39.6*RSTJC
02700	26	RA=RA+Y*RC
02800		R(3,IZ)=STAFF
02900		R(4,IZ)=RB
03000		R(5,IZ)=RC
03100	
03200		DO 364 JE=6,8
03300		Y=0
03400		DO 363 JD=1,4
03500	361	JC=INP(L)
03600		IF(JC.NE.'/')GO TO 365
03700		JC=JD
03800		DO 367 KA=JE,8
03900		X=.990
04000		DO 366 K=JC,4
04100		Y=Y+X
04200	366	X=X*100.0
04300		R(KA,IZ)=Y
04400		JC=1
04500	367	Y=0
04600		L=L+1
04700	C  L=CHARACTER COUNTER
04800		GO TO 369
04900	365	DO 362 J=1,12
05000		IF(JC.NE.JALPHA(J))GO TO 362
05100		N=35+J
05200		GO TO 39
05300	362	CONTINUE
05400	38	N=10-('A'-INP(L))/536870912
05500	C   MAGIC NUMBER TO FIND LETTERS
05600		IF(N.LT.10)N=N+7
05700	39	L=L+1
05900	C  BLANK=99(=47)
06000		X=N
06100		IF(JD.EQ.2)X=X*100.
06200		IF(JD.EQ.4)X=X/100.
06300		IF(JD.EQ.1)X=X*10000.
06400	363	Y=Y+X
06500	364	R(JE,IZ)=Y
06600	369	IF(L.LT.KN)GO TO 368
06700	
06800		INP(1)=0
06900	C   SO IT WON'T FIND A COMMAND IN THE MAIN PROG.
07000		IF(RNFLG.NE.0)CALL SETLET
07100		GO TO 8024
07400	C  PACKS 4 CHARS/WD, 3 WDS/ITEM.  ORDER=[, - . = ( )]  000000.00
07500	
07600	5016	IF(IAMP.GE.0)GO TO 1299
07700		IF(PARENS.NE.0)GO TO 3362
07800	C  PARENS ARE STILL OPEN?
07900		GO TO 3013
08000	103	K=INP(ML)
08100	
08200	C   LAST SECTION
08300		IF(K.EQ.ISEMI)GO TO 1014
08600	C*********** MODE #?
08700		IF(K.NE.IBLA) GO TO 1899
08800		ML=ML+1
08900		GO TO 103
09000	1899	JA=0
09100	C   MUST BE ZERO IN SCANR
09200		CALL SCANR
09300	      IF(VX1.EQ.-99.)GO TO 4022
09400		IF(MODE.NE.2)GO TO 17
09500	C*********** MODE #?
09600	2017	IF(VX1.EQ.10000.)GO TO 17
09700	      VX1=4./VX1
09800		IF(JJ.NE.1)GO TO 2014
09900		V(I)=VX1
10000		GO TO 114
10100	2014	DO 9006 L=2,JJ
10200		IF(VX(L).EQ.0)GO TO 17
10300	9006	VX1=4./VX(L)+VX1
10400		JJ=1
10500	17	V(I)=VX1
10600		IF(JJ.LE.1)GO TO 114
10700		IF(MODE.NE.1.OR.VX2.EQ.0)GO TO 171
10800	C  JUMP IF RHY OR 'X 4' ETC.
10900		V(I)=-(VX1/100.+VX2/10000.)
11000	C  PACKS 2 METER NUMS INTO ONE SLOT (-.1208 = 12/8)
11100		GO TO 114
11200	171	L=VX(JJ)-1
11300		X=V(I)
11400		NL=I+1
11500		I=L+I
11600		DO 1017 K=NL,I
11700	1017	V(K)=X
11800	C   ADDS UP TOTAL   OF NOTES IN SEQ.
11900		GO TO 114
12000	1014	V(I)=RB
12100	114      RB=V(I)     
12200	      I=I+1 
12300	      GO TO 5016    
12400	4022      JC=VX2+.3
12500	      JD=VX3-.5
12600		IF(JJ.EQ.2)JD=1
12700	C   JC=HOW MANY TIMES,  JD=HOW MANY NOTES 
12800	      DO 1005 K=1,JD    
12900	       NL=I+JC-1  
13000	      DO 2005 L=I,NL    
13100	2005  V(L)=V(L-JC)
13200	1005      I=I+JC  
13300		RB=V(NL)
13400	C  RB SAVES DATA FOR SLASH REPEAT FEATURE.
13500	      GO TO 5016  
13600	
13700	3013	IF(MODE.EQ.2.AND.I-1.NE.IRHY)GO TO 8015
13800	C  WRONG NUMBER OF ITEMS
13900		V(I)=-99.
14100		IF(MODE.NE.1)GO TO 132
14200	131	CALL NOTES
14300		GO TO 8006
14400	132	CALL RHYTH
14500	CC	IF(R1.EQ.50)GO TO 8024
14600	C  =50 IS RHYTHM FOR TEXT
14650		IF(IREAD.EQ.0)CALL NUMB
14700		GO TO 8006
14800	C   ACCENTS ARE IN BEAMS SUBROUTINE
14900	133	CALL BEAMS
15000		IF(MODE.EQ.5)GO TO 8024
15100		IF(MODE.EQ.3)IBEAM=0
15200	C  FOR  STEM NORMALIZATION
15300		GO TO 8006
15400		END
15500	
15550		SUBROUTINE TYPE
15600		COMMON/ALF/INP(72),ML
15700		TYPE 8005
15800		ACCEPT 2114,INP
16000	2114	FORMAT(72A1)
16100	8005	FORMAT(' TYPE --'/)
16200		END